home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONT_FO / TCODE.C < prev    next >
Text File  |  1990-03-02  |  24KB  |  1,074 lines
  1. /*
  2.  * tcode.c -- translator functions for traversing parse trees and generating
  3.  *  code.
  4.  */
  5.  
  6. #include "::h:config.h"
  7. #include "tproto.h"
  8. #include "globals.h"
  9. #include "trans.h"
  10. #include "token.h"
  11. #include "tree.h"
  12. #include "tsym.h"
  13.  
  14. /*
  15.  * Prototypes.
  16.  */
  17.  
  18. hidden int    alclab        Params((int n));
  19. hidden novalue    binop        Params((int op));
  20. hidden novalue    emit        Params((char *s));
  21. hidden novalue    emitl        Params((char *s,int a));
  22. hidden novalue    emitlab        Params((int l));
  23. hidden novalue    emitn        Params((char *s,int a));
  24. hidden novalue    emits        Params((char *s,char *a));
  25. hidden novalue    setloc        Params((nodeptr n));
  26. hidden int    traverse    Params((nodeptr t));
  27. hidden novalue    unopa        Params((int op, nodeptr t));
  28. hidden novalue    unopb        Params((int op));
  29.  
  30. extern int tfatals;
  31. extern int nocode;
  32. extern char *comfile;
  33.  
  34. /*
  35.  * Code generator parameters.
  36.  */
  37.  
  38. #define LoopDepth   20        /* max. depth of nested loops */
  39. #define CaseDepth   10        /* max. depth of nested case statements */
  40. #define CreatDepth  10        /* max. depth of nested create statements */
  41.  
  42. /*
  43.  * loopstk structures hold information about nested loops.
  44.  */
  45. struct loopstk {
  46.    int nextlab;            /* label for next exit */
  47.    int breaklab;        /* label for break exit */
  48.    int markcount;        /* number of marks */
  49.    int ltype;            /* loop type */
  50.    };
  51.  
  52. /*
  53.  * casestk structure hold information about case statements.
  54.  */
  55. struct casestk {
  56.    int endlab;            /* label for exit from case statement */
  57.    nodeptr deftree;        /* pointer to tree for default clause */
  58.    };
  59.  
  60. /*
  61.  * creatstk structures hold information about create statements.
  62.  */
  63. struct creatstk {
  64.    int nextlab;            /* previous value of nextlab */
  65.    int breaklab;        /* previous value of breaklab */
  66.    };
  67. static int nextlab;        /* next label allocated by alclab() */
  68.  
  69. /*
  70.  * codegen - traverse tree t, generating code.
  71.  */
  72.  
  73. novalue codegen(t)
  74. nodeptr t;
  75.    {
  76.    nextlab = 1;
  77.    traverse(t);
  78.    }
  79.  
  80. /*
  81.  * traverse - traverse tree rooted at t and generate code.  This is just
  82.  *  plug and chug code for each of the node types.
  83.  */
  84.  
  85. static int traverse(t)
  86. register nodeptr t;
  87.    {
  88.    register int lab, n, i;
  89.    struct loopstk loopsave;
  90.    static struct loopstk loopstk[LoopDepth];    /* loop stack */
  91.    static struct loopstk *loopsp;
  92.    static struct casestk casestk[CaseDepth];    /* case stack */
  93.    static struct casestk *casesp;
  94.    static struct creatstk creatstk[CreatDepth]; /* create stack */
  95.    static struct creatstk *creatsp;
  96.  
  97.    n = 1;
  98.    switch (TType(t)) {
  99.  
  100.       case N_Activat:            /* co-expression activation */
  101.      if (Val0(Tree0(t)) == AUGACT) {
  102.         emit("pnull");
  103.         }
  104.      traverse(Tree2(t));        /* evaluate result expression */
  105.      if (Val0(Tree0(t)) == AUGACT)
  106.         emit("sdup");
  107.      traverse(Tree1(t));        /* evaluate activate expression */
  108.      setloc(t);
  109.      emit("coact");
  110.      if (Val0(Tree0(t)) == AUGACT)
  111.         emit("asgn");
  112.      break;
  113.  
  114.       case N_Alt:            /* alternation */
  115.      lab = alclab(2);
  116.      emitl("mark", lab);
  117.      loopsp->markcount++;
  118.      traverse(Tree0(t));        /* evaluate first alternative */
  119.      loopsp->markcount--;
  120.      emit("esusp");                 /*  and suspend with its result */
  121.      emitl("goto", lab+1);
  122.      emitlab(lab);
  123.      traverse(Tree1(t));        /* evaluate second alternative */
  124.      emitlab(lab+1);
  125.      break;
  126.  
  127.       case N_Augop:            /* augmented assignment */
  128.       case N_Binop:            /*  or a binary operator */
  129.      emit("pnull");
  130.      traverse(Tree1(t));
  131.      if (TType(t) == N_Augop)
  132.         emit("dup");
  133.      traverse(Tree2(t));
  134.      setloc(t);
  135.      binop((int)Val0(Tree0(t)));
  136.      break;
  137.  
  138.       case N_Bar:            /* repeated alternation */
  139.      lab = alclab(1);
  140.      emitlab(lab);
  141.      emit("mark0");         /* fail if expr fails first time */
  142.      loopsp->markcount++;
  143.      traverse(Tree0(t));        /* evaluate first alternative */
  144.      loopsp->markcount--;
  145.      emitl("chfail", lab);          /* change to loop on failure */
  146.      emit("esusp");                 /* suspend result */
  147.      break;
  148.  
  149.       case N_Break:            /* break expression */
  150.      if (loopsp->breaklab <= 0)
  151.         nfatal(t, "invalid context for break");
  152.      else {
  153.         for (i = 0; i < loopsp->markcount; i++)
  154.            emit("unmark");
  155.         loopsave = *loopsp--;
  156.         traverse(Tree0(t));
  157.         *++loopsp = loopsave;
  158.         emitl("goto", loopsp->breaklab);
  159.         }
  160.      break;
  161.  
  162.       case N_Case:            /* case expression */
  163.      lab = alclab(1);
  164.      casesp++;
  165.      casesp->endlab = lab;
  166.      casesp->deftree = NULL;
  167.      emit("mark0");
  168.      loopsp->markcount++;
  169.      traverse(Tree0(t));        /* evaluate control expression */
  170.      loopsp->markcount--;
  171.      emit("eret");
  172.      traverse(Tree1(t));        /* do rest of case (CLIST) */
  173.      if (casesp->deftree != NULL) { /* evaluate default clause */
  174.         emit("pop");
  175.         traverse(casesp->deftree);
  176.         }
  177.      else
  178.         emit("efail");
  179.      emitlab(lab);            /* end label */
  180.      casesp--;
  181.      break;
  182.  
  183.       case N_Ccls:            /* case expression clause */
  184.      if (TType(Tree0(t)) == N_Res && /* default clause */
  185.          Val0(Tree0(t)) == DEFAULT) {
  186.         if (casesp->deftree != NULL)
  187.            nfatal(t, "more than one default clause");
  188.         else
  189.            casesp->deftree = Tree1(t);
  190.         }
  191.      else {                /* case clause */
  192.         lab = alclab(1);
  193.         emitl("mark", lab);
  194.         loopsp->markcount++;
  195.         emit("ccase");
  196.         traverse(Tree0(t));        /* evaluate selector */
  197.         setloc(t);
  198.         emit("eqv");
  199.         loopsp->markcount--;
  200.         emit("unmark");
  201.         emit("pop");
  202.         traverse(Tree1(t));        /* evaluate expression */
  203.         emitl("goto", casesp->endlab); /* goto end label */
  204.         emitlab(lab);        /* label for next clause */
  205.         }
  206.      break;
  207.  
  208.       case N_Clist:            /* list of case clauses */
  209.      traverse(Tree0(t));
  210.      traverse(Tree1(t));
  211.      break;
  212.  
  213.       case N_Conj:            /* conjunction */
  214.      if (Val0(Tree0(t)) == AUGAND) {
  215.         emit("pnull");
  216.         }
  217.      traverse(Tree1(t));
  218.      if (Val0(Tree0(t)) != AUGAND)
  219.         emit("pop");
  220.      traverse(Tree2(t));
  221.      if (Val0(Tree0(t)) == AUGAND) {
  222.         setloc(t);
  223.         emit("asgn");
  224.         }
  225.      break;
  226.  
  227.       case N_Create:            /* create expression */
  228.      creatsp++;
  229.      creatsp->nextlab = loopsp->nextlab;
  230.      creatsp->breaklab = loopsp->breaklab;
  231.      loopsp->nextlab = 0;        /* make break and next illegal */
  232.      loopsp->breaklab = 0;
  233.      lab = alclab(3);
  234.      emitl("goto", lab+2);          /* skip over code for co-expression */
  235.      emitlab(lab);            /* entry point */
  236.      emit("pop");                   /* pop the result from activation */
  237.      emitl("mark", lab+1);
  238.      loopsp->markcount++;
  239.      traverse(Tree0(t));        /* traverse code for co-expression */
  240.      loopsp->markcount--;
  241.      setloc(t);
  242.      emit("coret");                 /* return to activator */
  243.      emit("efail");                 /* drive co-expression */
  244.      emitlab(lab+1);        /* loop on exhaustion */
  245.      emit("cofail");                /* and fail each time */
  246.      emitl("goto", lab+1);
  247.      emitlab(lab+2);
  248.      emitl("create", lab);          /* create entry block */
  249.      loopsp->nextlab = creatsp->nextlab;   /* legalize break and next */
  250.      loopsp->breaklab = creatsp->breaklab;
  251.      creatsp--;
  252.      break;
  253.  
  254.       case N_Cset:            /* cset literal */
  255.      emitn("cset", (int)Val0(t));
  256.      break;
  257.  
  258.       case N_Elist:            /* expression list */
  259.      n = traverse(Tree0(t));
  260.      n += traverse(Tree1(t));
  261.      break;
  262.  
  263.       case N_Empty:            /* a missing expression */
  264.      emit("pnull");
  265.      break;
  266.  
  267.       case N_Field:            /* field reference */
  268.      emit("pnull");
  269.      traverse(Tree0(t));
  270.      setloc(t);
  271.      emits("field", Str0(Tree1(t)));
  272.      break;
  273.  
  274.  
  275.       case N_Id:            /* identifier */
  276.      emitn("var", (int)Val0(t));
  277.      break;
  278.  
  279.       case N_If:            /* if expression */
  280.      if (TType(Tree2(t)) == N_Empty) {
  281.         lab = 0;
  282.         emit("mark0");
  283.         }
  284.      else {
  285.         lab = alclab(2);
  286.         emitl("mark", lab);
  287.         }
  288.      loopsp->markcount++;
  289.      traverse(Tree0(t));
  290.      loopsp->markcount--;
  291.      emit("unmark");
  292.      traverse(Tree1(t));
  293.      if (lab > 0) {
  294.         emitl("goto", lab+1);
  295.         emitlab(lab);
  296.         traverse(Tree2(t));
  297.         emitlab(lab+1);
  298.         }
  299.      break;
  300.  
  301.       case N_Int:            /* integer literal */
  302.      emitn("int", (int)Val0(t));
  303.      break;
  304.  
  305.  
  306.       case N_Apply:            /* application */
  307.          traverse(Tree0(t));
  308.          traverse(Tree1(t));
  309.          emitn("invoke", -1);
  310.          break;
  311.  
  312.       case N_Invok:            /* invocation */
  313.      if (TType(Tree0(t)) != N_Empty) {
  314.         traverse(Tree0(t));
  315.          }
  316.      else {
  317.         emit("pushn1");             /* default to -1(e1,...,en) */
  318.         }
  319.      n = traverse(Tree1(t));
  320.      setloc(t);
  321.      emitn("invoke", n);
  322.      n = 1;
  323.      break;
  324.  
  325.       case N_Key:            /* keyword reference */
  326.      setloc(t);
  327.      emitn("keywd", (int)Val0(t));
  328.      break;
  329.  
  330.       case N_Limit:            /* limitation */
  331.      traverse(Tree1(t));
  332.      setloc(t);
  333.      emit("limit");
  334.      loopsp->markcount++;
  335.      traverse(Tree0(t));
  336.      loopsp->markcount--;
  337.      emit("lsusp");
  338.      break;
  339.  
  340.       case N_List:            /* list construction */
  341.      emit("pnull");
  342.      if (TType(Tree0(t)) == N_Empty)
  343.         n = 0;
  344.      else
  345.         n = traverse(Tree0(t));
  346.      setloc(t);
  347.      emitn("llist", n);
  348.      n = 1;
  349.      break;
  350.  
  351.       case N_Loop:            /* loop */
  352.      switch ((int)Val0(Tree0(t))) {
  353.         case EVERY:
  354.            lab = alclab(2);
  355.            loopsp++;
  356.            loopsp->ltype = EVERY;
  357.            loopsp->nextlab = lab;
  358.            loopsp->breaklab = lab + 1;
  359.            loopsp->markcount = 1;
  360.            emit("mark0");
  361.            traverse(Tree1(t));
  362.            emit("pop");
  363.            if (TType(Tree2(t)) != N_Empty) {   /* every e1 do e2 */
  364.           emit("mark0");
  365.           loopsp->ltype = N_Loop;
  366.           loopsp->markcount++;
  367.           traverse(Tree2(t));
  368.           loopsp->markcount--;
  369.           emit("unmark");
  370.           }
  371.            emitlab(loopsp->nextlab);
  372.            emit("efail");
  373.            emitlab(loopsp->breaklab);
  374.            loopsp--;
  375.            break;
  376.  
  377.         case REPEAT:
  378.            lab = alclab(3);
  379.            loopsp++;
  380.            loopsp->ltype = N_Loop;
  381.            loopsp->nextlab = lab + 1;
  382.            loopsp->breaklab = lab + 2;
  383.            loopsp->markcount = 1;
  384.            emitlab(lab);
  385.            emitl("mark", lab);
  386.            traverse(Tree1(t));
  387.            emitlab(loopsp->nextlab);
  388.            emit("unmark");
  389.            emitl("goto", lab);
  390.            emitlab(loopsp->breaklab);
  391.            loopsp--;
  392.            break;
  393.  
  394.         case SUSPEND:            /* suspension expression */
  395.            if (creatsp > creatstk)
  396.           nfatal(t, "invalid context for suspend");
  397.            lab = alclab(2);
  398.            loopsp++;
  399.            loopsp->ltype = EVERY;        /* like every ... do for next */
  400.            loopsp->nextlab = lab;
  401.            loopsp->breaklab = lab + 1;
  402.            loopsp->markcount = 1;
  403.            emit("mark0");
  404.            traverse(Tree1(t));
  405.            setloc(t);
  406.            emit("psusp");
  407.            emit("pop");
  408.            if (TType(Tree2(t)) != N_Empty) { /* suspend e1 do e2 */
  409.           emit("mark0");
  410.           loopsp->ltype = N_Loop;
  411.           loopsp->markcount++;
  412.           traverse(Tree2(t));
  413.           loopsp->markcount--;
  414.           emit("unmark");
  415.           }
  416.            emitlab(loopsp->nextlab);
  417.            emit("efail");
  418.            emitlab(loopsp->breaklab);
  419.            loopsp--;
  420.            break;
  421.  
  422.         case WHILE:
  423.            lab = alclab(3);
  424.            loopsp++;
  425.            loopsp->ltype = N_Loop;
  426.            loopsp->nextlab = lab + 1;
  427.            loopsp->breaklab = lab + 2;
  428.            loopsp->markcount = 1;
  429.            emitlab(lab);
  430.            emit("mark0");
  431.            traverse(Tree1(t));
  432.            if (TType(Tree2(t)) != N_Empty) {
  433.           emit("unmark");
  434.           emitl("mark", lab);
  435.           traverse(Tree2(t));
  436.           }
  437.            emitlab(loopsp->nextlab);
  438.            emit("unmark");
  439.            emitl("goto", lab);
  440.            emitlab(loopsp->breaklab);
  441.            loopsp--;
  442.            break;
  443.  
  444.         case UNTIL:
  445.            lab = alclab(4);
  446.            loopsp++;
  447.            loopsp->ltype = N_Loop;
  448.            loopsp->nextlab = lab + 2;
  449.            loopsp->breaklab = lab + 3;
  450.            loopsp->markcount = 1;
  451.            emitlab(lab);
  452.            emitl("mark", lab+1);
  453.            traverse(Tree1(t));
  454.            emit("unmark");
  455.            emit("efail");
  456.            emitlab(lab+1);
  457.            emitl("mark", lab);
  458.            traverse(Tree2(t));
  459.            emitlab(loopsp->nextlab);
  460.            emit("unmark");
  461.            emitl("goto", lab);
  462.            emitlab(loopsp->breaklab);
  463.            loopsp--;
  464.            break;
  465.         }
  466.      break;
  467.  
  468.       case N_Next:            /* next expression */
  469.      if (loopsp < loopstk || loopsp->nextlab <= 0)
  470.         nfatal(t, "invalid context for next");
  471.      else {
  472.         if (loopsp->ltype != EVERY && loopsp->markcount > 1)
  473.            for (i = 0; i < loopsp->markcount - 1; i++)
  474.           emit("unmark");
  475.         emitl("goto", loopsp->nextlab);
  476.         }
  477.      break;
  478.  
  479.       case N_Not:            /* not expression */
  480.      lab = alclab(1);
  481.      emitl("mark", lab);
  482.      loopsp->markcount++;
  483.      traverse(Tree0(t));
  484.      loopsp->markcount--;
  485.      emit("unmark");
  486.      emit("efail");
  487.      emitlab(lab);
  488.      emit("pnull");
  489.      break;
  490.  
  491.       case N_Proc:            /* procedure */
  492.      loopsp = loopstk;
  493.      loopsp->nextlab = 0;
  494.      loopsp->breaklab = 0;
  495.      loopsp->markcount = 0;
  496.      casesp = casestk;
  497.      creatsp = creatstk;
  498.  
  499.  
  500.      writecheck(fprintf(codefile, "proc %s\n", Str0(Tree0(t))));
  501.      lout(codefile);
  502.      cout(codefile);
  503.  
  504.      emit("declend");
  505.      setloc(t);
  506.      if (TType(Tree1(t)) != N_Empty) {
  507.         lab = alclab(1);
  508.         emitl("init", lab);
  509.         emitl("mark", lab);
  510.         traverse(Tree1(t));
  511.         emit("unmark");
  512.         emitlab(lab);
  513.         }
  514.      if (TType(Tree2(t)) != N_Empty)
  515.         traverse(Tree2(t));
  516.      setloc(Tree3(t));
  517.      emit("pfail");
  518.      emit("end");
  519.      if (!silent)
  520.         fprintf(stderr, "  %s (%d/%d)\n", Str0(Tree0(t)),
  521.         (int)((word *)tfree - (word *)tree), (int)tsize);
  522.      break;
  523.  
  524.       case N_Real:            /* real literal */
  525.      emitn("real", (int)Val0(t));
  526.      break;
  527.  
  528.       case N_Ret:            /* return expression */
  529.      if (creatsp > creatstk)
  530.         nfatal(t, "invalid context for return or fail");
  531.      if (Val0(Tree0(t)) != FAIL) {
  532.         lab = alclab(1);
  533.         emitl("mark", lab);
  534.         loopsp->markcount++;
  535.         traverse(Tree1(t));
  536.         loopsp->markcount--;
  537.         setloc(t);
  538.         emit("pret");
  539.         emitlab(lab);
  540.         }
  541.      setloc(t);
  542.      emit("pfail");
  543.      break;
  544.  
  545.       case N_Scan:            /* scanning expression */
  546.      if (Val0(Tree0(t)) == SCANASGN)
  547.         emit("pnull");
  548.      traverse(Tree1(t));
  549.      if (Val0(Tree0(t)) == SCANASGN)
  550.         emit("sdup");
  551.      setloc(t);
  552.      emit("bscan");
  553.      traverse(Tree2(t));
  554.      setloc(t);
  555.      emit("escan");
  556.      if (Val0(Tree0(t)) == SCANASGN)
  557.         emit("asgn");
  558.      break;
  559.  
  560.       case N_Sect:            /* section operation */
  561.      emit("pnull");
  562.      traverse(Tree1(t));
  563.      traverse(Tree2(t));
  564.      if (Val0(Tree0(t)) == PCOLON || Val0(Tree0(t)) == MCOLON)
  565.         emit("dup");
  566.      traverse(Tree3(t));
  567.      setloc(Tree0(t));
  568.      if (Val0(Tree0(t)) == PCOLON)
  569.         emit("plus");
  570.      else if (Val0(Tree0(t)) == MCOLON)
  571.         emit("minus");
  572.      setloc(t);
  573.      emit("sect");
  574.      break;
  575.  
  576.       case N_Slist:            /* semicolon-separated expr list */
  577.      lab = alclab(1);
  578.      emitl("mark", lab);
  579.      loopsp->markcount++;
  580.      traverse(Tree0(t));
  581.      loopsp->markcount--;
  582.      emit("unmark");
  583.      emitlab(lab);
  584.      traverse(Tree1(t));
  585.      break;
  586.  
  587.       case N_Str:            /* string literal */
  588.      emitn("str", (int)Val0(t));
  589.      break;
  590.  
  591.       case N_To:            /* to expression */
  592.      emit("pnull");
  593.      traverse(Tree0(t));
  594.      traverse(Tree1(t));
  595.      emit("push1");
  596.      setloc(t);
  597.      emit("toby");
  598.      break;
  599.  
  600.       case N_ToBy:            /* to-by expression */
  601.      emit("pnull");
  602.      traverse(Tree0(t));
  603.      traverse(Tree1(t));
  604.      traverse(Tree2(t));
  605.      setloc(t);
  606.      emit("toby");
  607.      break;
  608.  
  609.       case N_Unop:            /* unary operator */
  610.      unopa((int)Val0(Tree0(t)),t);
  611.      traverse(Tree1(t));
  612.      setloc(t);
  613.      unopb((int)Val0(Tree0(t)));
  614.      break;
  615.  
  616.       default:
  617.      emitn("?????", TType(t));
  618.      tsyserr("traverse: undefined node type");
  619.       }
  620.    return n;
  621.    }
  622.  
  623. /*
  624.  * binop emits code for binary operators.  For non-augmented operators,
  625.  *  the name of operator is emitted.  For augmented operators, an "asgn"
  626.  *  is emitted after the name of the operator.
  627.  */
  628. static novalue binop(op)
  629. int op;
  630.    {
  631.    register int asgn;
  632.    register char *name;
  633.  
  634.    asgn = 0;
  635.    switch (op) {
  636.  
  637.       case ASSIGN:
  638.      name = "asgn";
  639.      break;
  640.  
  641.       case CARETASGN:
  642.      asgn++;
  643.       case CARET:
  644.      name = "power";
  645.      break;
  646.  
  647.       case CONCATASGN:
  648.      asgn++;
  649.       case CONCAT:
  650.      name = "cat";
  651.      break;
  652.  
  653.       case DIFFASGN:
  654.      asgn++;
  655.       case DIFF:
  656.      name = "diff";
  657.      break;
  658.  
  659.       case AUGEQV:
  660.      asgn++;
  661.       case EQUIV:
  662.      name = "eqv";
  663.      break;
  664.  
  665.       case INTERASGN:
  666.      asgn++;
  667.       case INTER:
  668.      name = "inter";
  669.      break;
  670.  
  671.       case LBRACK:
  672.      name = "subsc";
  673.      break;
  674.  
  675.       case LCONCATASGN:
  676.      asgn++;
  677.       case LCONCAT:
  678.      name = "lconcat";
  679.      break;
  680.  
  681.       case AUGSEQ:
  682.      asgn++;
  683.       case LEXEQ:
  684.      name = "lexeq";
  685.      break;
  686.  
  687.       case AUGSGE:
  688.      asgn++;
  689.       case LEXGE:
  690.      name = "lexge";
  691.      break;
  692.  
  693.       case AUGSGT:
  694.      asgn++;
  695.       case LEXGT:
  696.      name = "lexgt";
  697.      break;
  698.  
  699.       case AUGSLE:
  700.      asgn++;
  701.       case LEXLE:
  702.      name = "lexle";
  703.      break;
  704.  
  705.       case AUGSLT:
  706.      asgn++;
  707.       case LEXLT:
  708.      name = "lexlt";
  709.      break;
  710.  
  711.       case AUGSNE:
  712.      asgn++;
  713.       case LEXNE:
  714.      name = "lexne";
  715.      break;
  716.  
  717.       case MINUSASGN:
  718.      asgn++;
  719.       case MINUS:
  720.      name = "minus";
  721.      break;
  722.  
  723.       case MODASGN:
  724.      asgn++;
  725.       case MOD:
  726.      name = "mod";
  727.      break;
  728.  
  729.       case AUGNEQV:
  730.      asgn++;
  731.       case NOTEQUIV:
  732.      name = "neqv";
  733.      break;
  734.  
  735.       case AUGEQ:
  736.      asgn++;
  737.       case NUMEQ:
  738.      name = "numeq";
  739.      break;
  740.  
  741.       case AUGGE:
  742.      asgn++;
  743.       case NUMGE:
  744.      name = "numge";
  745.      break;
  746.  
  747.       case AUGGT:
  748.      asgn++;
  749.       case NUMGT:
  750.      name = "numgt";
  751.      break;
  752.  
  753.       case AUGLE:
  754.      asgn++;
  755.       case NUMLE:
  756.      name = "numle";
  757.      break;
  758.  
  759.       case AUGLT:
  760.      asgn++;
  761.       case NUMLT:
  762.      name = "numlt";
  763.      break;
  764.  
  765.       case AUGNE:
  766.      asgn++;
  767.       case NUMNE:
  768.      name = "numne";
  769.      break;
  770.  
  771.       case PLUSASGN:
  772.      asgn++;
  773.       case PLUS:
  774.      name = "plus";
  775.      break;
  776.  
  777.       case REVASSIGN:
  778.      name = "rasgn";
  779.      break;
  780.  
  781.       case REVSWAP:
  782.      name = "rswap";
  783.      break;
  784.  
  785.       case SLASHASGN:
  786.      asgn++;
  787.       case SLASH:
  788.      name = "div";
  789.      break;
  790.  
  791.       case STARASGN:
  792.      asgn++;
  793.       case STAR:
  794.      name = "mult";
  795.      break;
  796.  
  797.       case SWAP:
  798.      name = "swap";
  799.      break;
  800.  
  801.       case UNIONASGN:
  802.      asgn++;
  803.       case UNION:
  804.      name = "unions";
  805.      break;
  806.  
  807.       default:
  808.      emitn("?binop", op);
  809.      tsyserr("binop: undefined binary operator");
  810.       }
  811.    emit(name);
  812.    if (asgn)
  813.       emit("asgn");
  814.  
  815.    }
  816. /*
  817.  * unopa and unopb handle code emission for unary operators. unary operator
  818.  *  sequences that are the same as binary operator sequences are recognized
  819.  *  by the lexical analyzer as binary operators.  For example, ~===x means to
  820.  *  do three tab(match(...)) operations and then a cset complement, but the
  821.  *  lexical analyzer sees the operator sequence as the "neqv" binary
  822.  *  operation.    unopa and unopb unravel tokens of this form.
  823.  *
  824.  * When a N_Unop node is encountered, unopa is called to emit the necessary
  825.  *  number of "pnull" operations to receive the intermediate results.  This
  826.  *  amounts to a pnull for each operation.
  827.  */
  828. static novalue unopa(op,t)
  829. int op;
  830. nodeptr t;
  831.    {
  832.    switch (op) {
  833.       case NOTEQUIV:        /* unary ~ and three = operators */
  834.      emit("pnull");
  835.       case LEXNE:        /* unary ~ and two = operators */
  836.       case EQUIV:        /* three unary = operators */
  837.      emit("pnull");
  838.       case NUMNE:        /* unary ~ and = operators */
  839.       case UNION:        /* two unary + operators */
  840.       case DIFF:        /* two unary - operators */
  841.       case LEXEQ:        /* two unary = operators */
  842.       case INTER:        /* two unary * operators */
  843.      emit("pnull");
  844.       case BACKSLASH:        /* unary \ operator */
  845.       case BANG:        /* unary ! operator */
  846.       case CARET:        /* unary ^ operator */
  847.       case PLUS:        /* unary + operator */
  848.       case TILDE:        /* unary ~ operator */
  849.       case MINUS:        /* unary - operator */
  850.       case NUMEQ:        /* unary = operator */
  851.       case STAR:        /* unary * operator */
  852.       case QMARK:        /* unary ? operator */
  853.       case SLASH:        /* unary / operator */
  854.      emit("pnull");
  855.      break;
  856.       case DOT:            /* unary . operator */
  857.          if (TType(Tree1(t)) == N_Int || TType(Tree1(t)) == N_Real) {
  858.             if (!silent) {
  859.                nfatal(t,"dereferencing operator applied to numeric literal");
  860.                tfatals--;            /* for now */
  861.                nocode--;
  862.                }
  863.             }
  864.          emit("pnull");
  865.          break;
  866.       default:
  867.      tsyserr("unopa: undefined unary operator");
  868.       }
  869.    }
  870.  
  871. /*
  872.  * unopb is the back-end code emitter for unary operators.  It emits
  873.  *  the operations represented by the token op.  For tokens representing
  874.  *  a single operator, the name of the operator is emitted.  For tokens
  875.  *  representing a sequence of operators, recursive calls are used.  In
  876.  *  such a case, the operator sequence is "scanned" from right to left
  877.  *  and unopb is called with the token for the appropriate operation.
  878.  *
  879.  * For example, consider the sequence of calls and code emission for "~===":
  880.  *    unopb(NOTEQUIV)        ~===
  881.  *        unopb(NUMEQ)    =
  882.  *        emits "tabmat"
  883.  *        unopb(NUMEQ)    =
  884.  *        emits "tabmat"
  885.  *        unopb(NUMEQ)    =
  886.  *        emits "tabmat"
  887.  *        emits "compl"
  888.  */
  889. static novalue unopb(op)
  890. int op;
  891.    {
  892.    register char *name;
  893.  
  894.    switch (op) {
  895.  
  896.       case DOT:            /* unary . operator */
  897.      name = "value";
  898.      break;
  899.  
  900.       case BACKSLASH:        /* unary \ operator */
  901.      name = "nonnull";
  902.      break;
  903.  
  904.       case BANG:        /* unary ! operator */
  905.      name = "bang";
  906.      break;
  907.  
  908.       case CARET:        /* unary ^ operator */
  909.      name = "refresh";
  910.      break;
  911.  
  912.       case UNION:        /* two unary + operators */
  913.      unopb(PLUS);
  914.       case PLUS:        /* unary + operator */
  915.      name = "number";
  916.      break;
  917.  
  918.       case NOTEQUIV:        /* unary ~ and three = operators */
  919.      unopb(NUMEQ);
  920.       case LEXNE:        /* unary ~ and two = operators */
  921.      unopb(NUMEQ);
  922.       case NUMNE:        /* unary ~ and = operators */
  923.      unopb(NUMEQ);
  924.       case TILDE:        /* unary ~ operator (cset compl) */
  925.      name = "compl";
  926.      break;
  927.  
  928.       case DIFF:        /* two unary - operators */
  929.      unopb(MINUS);
  930.       case MINUS:        /* unary - operator */
  931.      name = "neg";
  932.      break;
  933.  
  934.       case EQUIV:        /* three unary = operators */
  935.      unopb(NUMEQ);
  936.       case LEXEQ:        /* two unary = operators */
  937.      unopb(NUMEQ);
  938.       case NUMEQ:        /* unary = operator */
  939.      name = "tabmat";
  940.      break;
  941.  
  942.       case INTER:        /* two unary * operators */
  943.      unopb(STAR);
  944.       case STAR:        /* unary * operator */
  945.      name = "size";
  946.      break;
  947.  
  948.       case QMARK:        /* unary ? operator */
  949.      name = "random";
  950.      break;
  951.  
  952.       case SLASH:        /* unary / operator */
  953.      name = "null";
  954.      break;
  955.  
  956.       default:
  957.      emitn("?unop", op);
  958.      tsyserr("unopb: undefined unary operator");
  959.       }
  960.    emit(name);
  961.    }
  962.  
  963. /*
  964.  * setloc emits "filen" and "line" directives for the source location of
  965.  *  node n.  A directive is only emitted if the corrosponding value
  966.  *  has changed since the last time setloc was called.  Note:  File(n)
  967.  *  reportedly occasionally points at uninitialized data, producing
  968.  *  bogus results (as well as reams of filen commands).  We could use
  969.  *  comfile here instead; that would ignore any #line directives.
  970.  */
  971. static char *lastfiln = NULL;
  972. static int lastline = 0;
  973.  
  974. #ifdef EvalTrace
  975. static int lastcol = 0;
  976. #endif                    /* EvalTrace */
  977.  
  978. static novalue setloc(n)
  979. nodeptr n;
  980.    {
  981.    if ((n != NULL) &&
  982.       (TType(n) != N_Empty) &&
  983.       (File(n) != NULL) &&
  984.       (lastfiln == NULL || strcmp(File(n), lastfiln) != 0)) {
  985.          lastfiln = File(n);
  986.          emits("filen", lastfiln);
  987.          }
  988.    if (Line(n) != lastline) {
  989.       lastline = Line(n);
  990.       emitn("line", Line(n));
  991.          }
  992.  
  993. #ifdef EvalTrace
  994.    if (Col(n) != lastcol) {
  995.       lastcol = Col(n);
  996.       emitn("colm", Col(n));
  997.       }
  998. #endif                    /* EvalTrace */
  999.  
  1000.  
  1001.    }
  1002.  
  1003. #ifdef MultipleRuns
  1004. /*
  1005.  * Reinitialize last file name and line number for repeated runs.
  1006.  */
  1007. novalue tcodeinit()
  1008.    {
  1009.    lastfiln = NULL;
  1010.  
  1011. #ifdef EvalTrace
  1012.    lastcol = 0;
  1013. #endif                    /* EvalTrace */
  1014.  
  1015.    }
  1016. #endif                    /* Multiple Runs */
  1017.  
  1018. /*
  1019.  * The emit* routines output ucode to codefile.  The various routines are:
  1020.  *
  1021.  *  emitlab(l) - emit "lab" instruction for label l.
  1022.  *  emit(s) - emit instruction s.
  1023.  *  emitl(s,a) - emit instruction s with reference to label a.
  1024.  *  emitn(s,n) - emit instruction s with numeric argument a.
  1025.  *  emits(s,a) - emit instruction s with string argument a.
  1026.  */
  1027. static novalue emitlab(l)
  1028. int l;
  1029.    {
  1030.    writecheck(fprintf(codefile, "lab L%d\n", l));
  1031.    }
  1032.  
  1033. static novalue emit(s)
  1034. char *s;
  1035.    {
  1036.    writecheck(fprintf(codefile, "\t%s\n", s));
  1037.    }
  1038.  
  1039. static novalue emitl(s, a)
  1040. char *s;
  1041. int a;
  1042.    {
  1043.    writecheck(fprintf(codefile, "\t%s\tL%d\n", s, a));
  1044.    }
  1045.  
  1046. static novalue emitn(s, a)
  1047. char *s;
  1048. int a;
  1049.    {
  1050.    writecheck(fprintf(codefile, "\t%s\t%d\n", s, a));
  1051.    }
  1052.  
  1053.  
  1054. static novalue emits(s, a)
  1055. char *s, *a;
  1056.    {
  1057.    writecheck(fprintf(codefile, "\t%s\t%s\n", s, a));
  1058.    }
  1059.  
  1060. /*
  1061.  * alclab allocates n labels and returns the first.  For the interpreter,
  1062.  *  labels are restarted at 1 for each procedure, while in the compiler,
  1063.  *  they start at 1 and increase throughout the entire compilation.
  1064.  */
  1065. static int alclab(n)
  1066. int n;
  1067.    {
  1068.    register int lab;
  1069.  
  1070.    lab = nextlab;
  1071.    nextlab += n;
  1072.    return lab;
  1073.    }
  1074.